perm filename FILLMS.F4[MSS,LCS] blob sn#142458 filedate 1975-01-25 generic text, type T, neo UTF8
00010	C**** CHANGE 1, 2 AND 3 TO JFCL IN DDT WHEN USING DISTORTION.(SEE 'LINES')
00100		SUBROUTINE FILLMS(L,IDAT,RJB,CENTR,RJF,RJG)
00110		COMMON/DPY/ST(4000),WDS(250),MEDIT,IGO/DL/RSIZ,SAVER,NAME
00120		COMMON/DST/BB,CC/FLM/X(200),Y(200),NX(200)
00130		COMMON/ALF/INP(65),DX,RX,D,R,C,KK,J,ML
00200		DIMENSION IDAT(1)
00220		COMMON/PLTR/IPLT,RHT,DIS/LL/LL/STF/RR(8),RSTJC
00222	CC	INTEGER XGP
00225	CC	DATA XGP/2/,MD/6/
00226		DATA MD/6/
00227	C MD=DISPLAY   CHANGE XGP TO 1 IN DDT WHEN PLOTTING ON XGP!
00230		DX=DIS
00240		RX=RHT
00270		D=RSTJC*RJF
00280		R=RSTJC*RJG
00400	1	GO TO 10
00450		C=CC
00460		B=BB
00500	C  SAVES IT.  IT WILL RETURN LATER.
00525		BB=B/DIS
00550		CC=1000
00600	10	KK=0
00700		DO 205 J=1,L
00800		CALL UNPACK(M,N,IDAT(J))
00900		KK=KK+1
01000		NX(KK)=0
01100		IF(LL.EQ.3)NX(KK)=3
01200		X(KK)=ROFF((RJB+D*M)*DIS)
01300		Y(KK)=ROFF((CENTR+R*N)*RHT)
01310	2	GO TO 205
01320		Y(KK)=Y(KK)*(C-BB*(ABS(X(KK))))
01330	C  FOR DISTORTION
01340	205	CONTINUE
01400		NX(1)=KK
01410		DIS=1.0
01420		RHT=DIS
01500		M=MD
01600	CC	IF(IPLT)M=MP-IXRX
01610		IF(IPLT.GE.0)GO TO 20
01615	CC	M=RSIZ+.4
01617		M=1
01620		IF(RSIZ.GE.2.)M=2
01630	CC	IF(M.GT.XGP)M=XGP
01650	C  STOPS DISTORTION IN 'LINES'
01700	20	CALL FILLER(X,Y,NX,M)
01710		DIS=DX
01720		RHT=RX
01730	3	RETURN
01740	C  NEXT TO RESET DISTORTION FACT.
01745		BB=B
01750		CC=C
01800		END
01900	
02000		SUBROUTINE ROTATE(I,L)
02100		DIMENSION I(1)
02105		COMMON/LL/LL
02110		COMMON RJB,JA,CENTR,JB,RJQ(20),JQ(20)/STF/RR(8),RSTJC
02155		EQUIVALENCE (RJF,RJQ(4)),(RJG,RJQ(5)),(DEG,RJQ(7))
02190		RJG=RJG*RSTJC
02195		RJF=RJF*RSTJC
02200		N=I(L)
02225		KNT=601
02250	C  ROTATED DATA IS PUT BACK STARTING AT LOCATION 601.
02275		I(KNT)=N
02300		DO 1 K=L+1,N+L-1
02400		CALL UNPACK(J,M,I(K))
02500		X=J*RJF
02600		Y=M*RJG
02700		JJ=I(K)/100000000
02800		AX=ATAN2(X,Y)*57.29578
02900		HYP=SQRT(X**2+Y**2)
03000		ROT=DEG+AX
03100		J=ROFF(HYP*COSD(ROT))
03200		M=ROFF(HYP*SIND(ROT))
03300		KNT=KNT+1
03400		IF(J)J=1000-J
03500		IF(M)M=1000-M
03600	1	I(KNT)=M*10000+J+JJ*100000000
03700		L=601
03800		RJF=1.
03900		RJG=1.
04000		RSTJC=1.
04100	C  SIZE CHANGES MUST BE MADE BEFORE ROTATION!!!!! ELSE IT DISTORTS.
04200		END